R Notebook

HW5: Correspondence analysis

Работа Ли-Мин Владиславы

if (!require("tidyverse")) install.packages("tidyverse")
if (!require("skimr")) install.packages("skimr")

library(tidyverse)
library(skimr)

infinitives <- read_tsv("https://raw.githubusercontent.com/olesar/2025dav4compling/refs/heads/main/data/PeriphrasticFutureMidRussian.txt", col_names = TRUE) %>%
  as.data.frame() %>%
    select(!ends_with("_Imp")) %>%
      select(!быти_Lform)

Rows: 23 Columns: 25
── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: "\t"
chr  (1): INF
dbl (24): быти_Fut, быти_Lform, мочи_Aor, мочи_Imp, мочи_Lform, мочи_Pres, начати_Aor, начати_Fut, начати_Imp, начати_Lform, почати_Aor, почати_Fu...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Проверка датасета

Пользуясь столбцом INF, дайте имя каждому ряду таблицы сопряженности (с помощью функции row.names или column_to_rownames). Оставьте в таблице только целочисленные данные. Выведите первые 6 строк таблицы. Проверьте, что таблица не содержит missing data.

# превращаем столбец INF в индекс
infinitives <- column_to_rownames(infinitives, 'INF')

# проверяем, нет ли пропущенных данных
sum(is.na(infinitives))

[1] 0

top_n(infinitives, 6)

Selecting by хотѣти_Pres

Chisq test

Примените тест Хи-квадрат Пирсона к таблице сопряженности.

Постройте таблицу с ожидаемыми значениями для таблицы сопряженности.

Предложите анализ теста Хи-квадрат. Что можно сказать об ассоциации между конструкциями (они обозначены вспомогательными глаголами в той или иной временной форме) и инфинитивами? Какие проблемы вы видите в применении теста Хи-квадрат к этим данным?

# применяем тест Хи-квадрат Пирсона
infinitives_chisq <- chisq.test(infinitives)

G2;H2;Warningh in chisq.test(infinitives) :
  аппроксимация на основе хи-квадрат может быть неправильнойg

infinitives_chisq

    Pearson's Chi-squared test

data:  infinitives
X-squared = 4569.9, df = 396, p-value < 2.2e-16

Статистическая интерпретация p-value

P-value меньше 0.05, а значит, при 5%-ом уровне значимости мы имеем основания отвергнуть нулевую гипотезу о независимости употребления вспомогательных глаголов и инфинитивов.

Содержательная интерпретация

Выбор начинательного глагола зависит от следующего за ним инфинитива.

# проверяем пропущенные значения
sum(is.na(infinitives))

[1] 0

# Таблица с ожидаемыми значениями
infinitives_chisq$expected

           быти_Fut  мочи_Aor мочи_Lform мочи_Pres начати_Aor начати_Fut начати_Lform почати_Aor почати_Fut почати_Lform  стати_Aor стати_Fut
бити      30.536356 0.9366980  2.4354149 12.083405  36.531223  3.5594525    0.4683490  2.9037639  0.9366980    11.989735 0.37467921  9.460650
быти      15.756202 0.4833191  1.2566296  6.234816  18.849444  1.8366125    0.2416595  1.4982891  0.4833191     6.186484 0.19332763  4.881523
воевати    7.250642 0.2224123  0.5782720  2.869119   8.674080  0.8451668    0.1112062  0.6894782  0.2224123     2.846878 0.08896493  2.246364
глаголати 15.477331 0.4747648  1.2343884  6.124465  18.515825  1.8041061    0.2373824  1.4717707  0.4747648     6.076989 0.18990590  4.795124
говорити  47.826347 1.4670659  3.8143713 18.925150  57.215569  5.5748503    0.7335329  4.5479042  1.4670659    18.778443 0.58682635 14.817365
дати       8.226689 0.2523524  0.6561163  3.255346   9.841745  0.9589393    0.1261762  0.7822926  0.2523524     3.230111 0.10094098  2.548760
держати    9.202737 0.2822926  0.7339607  3.641574  11.009410  1.0727117    0.1411463  0.8751069  0.2822926     3.613345 0.11291702  2.851155
дѣлати    14.361848 0.4405475  1.1454234  5.683062  17.181352  1.6740804    0.2202737  1.3656972  0.4405475     5.639008 0.17621899  4.449530
жаловати   7.111206 0.2181352  0.5671514  2.813944   8.507271  0.8289136    0.1090676  0.6762190  0.2181352     2.792130 0.08725406  2.203165
жити      30.954662 0.9495295  2.4687767 12.248931  37.031651  3.6082121    0.4747648  2.9435415  0.9495295    12.153978 0.37981180  9.590248
имѣти      8.923867 0.2737382  0.7117194  3.531223  10.675791  1.0402053    0.1368691  0.8485885  0.2737382     3.503849 0.10949530  2.764756
искати    20.218135 0.6201882  1.6124893  8.000428  24.187340  2.3567151    0.3100941  1.9225834  0.6201882     7.938409 0.24807528  6.263901
итти      17.011121 0.5218135  1.3567151  6.731394  20.350727  1.9828914    0.2609068  1.6176219  0.5218135     6.679213 0.20872541  5.270317
писати    14.222412 0.4362703  1.1343028  5.627887  17.014542  1.6578272    0.2181352  1.3524380  0.4362703     5.584260 0.17450813  4.406330
послати    8.784431 0.2694611  0.7005988  3.476048  10.508982  1.0239521    0.1347305  0.8353293  0.2694611     3.449102 0.10778443  2.721557
посылати   7.947819 0.2437981  0.6338751  3.144996   9.508127  0.9264328    0.1218991  0.7557742  0.2437981     3.120616 0.09751925  2.462361
просити   10.457656 0.3207870  0.8340462  4.138152  12.510693  1.2189906    0.1603935  0.9944397  0.3207870     4.106074 0.12831480  3.239949
пѣти       8.784431 0.2694611  0.7005988  3.476048  10.508982  1.0239521    0.1347305  0.8353293  0.2694611     3.449102 0.10778443  2.721557
служити   10.597092 0.3250642  0.8451668  4.193328  12.677502  1.2352438    0.1625321  1.0076989  0.3250642     4.160821 0.13002566  3.283148
сотворити  8.505560 0.2609068  0.6783576  3.365697  10.175364  0.9914457    0.1304534  0.8088109  0.2609068     3.339607 0.10436270  2.635158
стояти     7.390077 0.2266895  0.5893926  2.924294   8.840890  0.8614200    0.1133447  0.7027374  0.2266895     2.901625 0.09067579  2.289564
творити    7.668948 0.2352438  0.6116339  3.034645   9.174508  0.8939264    0.1176219  0.7292558  0.2352438     3.011121 0.09409752  2.375962
учинити    8.784431 0.2694611  0.7005988  3.476048  10.508982  1.0239521    0.1347305  0.8353293  0.2694611     3.449102 0.10778443  2.721557
          стати_Lform  учати_Aor учати_Fut учати_Lform хотѣти_Aor хотѣти_Lform хотѣти_Pres
бити         7.961933 0.09366980 38.029940   10.303678  2.3417451    13.113772   34.938837
быти         4.108212 0.04833191 19.622754    5.316510  1.2082977     6.766467   18.027802
воевати      1.890505 0.02224123  9.029940    2.446536  0.5560308     3.113772    8.295979
глаголати    4.035500 0.04747648 19.275449    5.222412  1.1869119     6.646707   17.708725
говорити    12.470060 0.14670659 59.562874   16.137725  3.6676647    20.538922   54.721557
дати         2.144996 0.02523524 10.245509    2.775877  0.6308811     3.532934    9.412746
держати      2.399487 0.02822926 11.461078    3.105218  0.7057314     3.952096   10.529512
дѣлати       3.744654 0.04405475 17.886228    4.846022  1.1013687     6.167665   16.432421
жаловати     1.854149 0.02181352  8.856287    2.399487  0.5453379     3.053892    8.136441
жити         8.071001 0.09495295 38.550898   10.444825  2.3738238    13.293413   35.417451
имѣти        2.326775 0.02737382 11.113772    3.011121  0.6843456     3.832335   10.210436
искати       5.271600 0.06201882 25.179641    6.822070  1.5504705     8.682635   23.133020
итти         4.435415 0.05218135 21.185629    5.739949  1.3045338     7.305389   19.463644
писати       3.708298 0.04362703 17.712575    4.798973  1.0906758     6.107784   16.272883
послати      2.290419 0.02694611 10.940120    2.964072  0.6736527     3.772455   10.050898
посылати     2.072284 0.02437981  9.898204    2.681779  0.6094953     3.413174    9.093670
просити      2.726689 0.03207870 13.023952    3.528657  0.8019675     4.491018   11.965355
пѣти         2.290419 0.02694611 10.940120    2.964072  0.6736527     3.772455   10.050898
служити      2.763045 0.03250642 13.197605    3.575706  0.8126604     4.550898   12.124893
сотворити    2.217707 0.02609068 10.592814    2.869974  0.6522669     3.652695    9.731822
стояти       1.926861 0.02266895  9.203593    2.493584  0.5667237     3.173653    8.455518
творити      1.999572 0.02352438  9.550898    2.587682  0.5881095     3.293413    8.774594
учинити      2.290419 0.02694611 10.940120    2.964072  0.6736527     3.772455   10.050898

Команда chisq.test(infinitives) вызывает предупреждение Chi-squared approximation may be incorrect, поскольку некоторые ожидаемые значения меньше 5. Это связано с тем, что тест хи-квадрат следует непрерывному распределению, но на малых выборках статистики не распределены непрерывно.

Baloon plot

С помощью функции balloonplot визуализируем данные в таблице сопряженности.

if (!require("gplots")) install.packages("gplots")
library("gplots")

options(repr.plot.width=15, repr.plot.height=15)


infinitives |> as.matrix() |> as.table() |>
  gplots::balloonplot(main ="", xlab ="", ylab="",
              label = FALSE, show.margins = FALSE, text.size=0.5, colsrt=45, colmar=3, rowmar=3)

Хи-квадрат на меньшей таблице

Оставьте меньшее количество строк и столбцов в таблице (вы можете убирать те или иные столбцы или объединять данные из нескольких столбцов или строк). Результирующая таблица должна быть размером не меньше 3 x 3 и корректна для проведения теста Хи-квадрат. Проведите снова тест Хи-квадрат и запишите ваши выводы.

Вычислите величину эффекта для теста с помощью V Крамера.

Визуализируйте таблицу с помощью мозаичного графика.

Запишите ваши выводы по ассоциации данных в меньшей таблице.

# группируем столбцы и суммируем значения
infinitives_grouped <- infinitives %>%
  rownames_to_column(var = "INF") %>%
  pivot_longer(cols=-INF, names_to = ".value",
               names_pattern = "(.*?)_") %>%
  mutate(быти = replace_na(быти, 0)) %>%
  group_by(INF) %>%
  summarise(across(everything(), sum)) %>%
  column_to_rownames('INF')
infinitives_grouped

# берем строки, где минимальное значение > 5
infinitives_short <- infinitives_grouped[c("бити","говорити","дѣлати","жити"),c("быти","начати","почати","стати","учати","хотѣти")]
infinitives_short

infinitives_short_chisq <- chisq.test(infinitives_short)
infinitives_short_chisq

    Pearson's Chi-squared test

data:  infinitives_short
X-squared = 216.82, df = 15, p-value < 2.2e-16

Уменьшился хи-квадрат и степень свободы, а p-value осталось прежним. Следовательно нулевую гипотезу о независимости вспомогательных глаголов и инфинитивов мы по-прежнему можем отвергнуть.

if (!require("lsr")) install.packages("lsr")

G3;Загрузка требуемого пакета: lsr
g

library(lsr)

# Вычисление величины эффекта для теста с помощью V Крамера.
cramersV(infinitives_short)

[1] 0.2865823

if (!require("vcd")) install.packages("vcd")

G3;Загрузка требуемого пакета: vcd
gG3;Загрузка требуемого пакета: grid
g

library(vcd)

infinitives_short

# Мозаичный график
library('vcd')

vcd::mosaic(
  infinitives_short_chisq$observed,
  set_varnames = list(A = "Инфинитив", B = "Вспомогательный глагол"),
  shade = TRUE,
  gp_labels = gpar(fontsize = 6)
)

Интерактивная тепловая карта

Вернемся к полной таблице сопряженности. Используйте функцию heatmaply для интерактивной визуализации ассоциации между строками и столбцами.

if (!require("heatmaply")) install.packages("heatmaply")
library(heatmaply)

heatmaply(infinitives)

Анализ соответствий

В этом разделе мы предлагаем использовать пакеты factoextra и FactoMineR, но вы можете использовать и другие пакеты R. Постройте модель анализа соответствий и запишите ее в переменную ca.model. Выведите summary модели.

if (!require("factoextra")) install.packages("factoextra")
library(factoextra)

if (!require("FactoMineR")) install.packages("FactoMineR")
library(FactoMineR)

ca.model <- FactoMineR::CA(infinitives, ncp = 5, graph = TRUE)

ca.model

**Results of the Correspondence Analysis (CA)**
The row variable has  23  categories; the column variable has 19 categories
The chi square of independence between the two variables is equal to 4569.931 (p-value =  0 ).
*The results are available in the following objects:

   name              description                   
1  "$eig"            "eigenvalues"                 
2  "$col"            "results for the columns"     
3  "$col$coord"      "coord. for the columns"      
4  "$col$cos2"       "cos2 for the columns"        
5  "$col$contrib"    "contributions of the columns"
6  "$row"            "results for the rows"        
7  "$row$coord"      "coord. for the rows"         
8  "$row$cos2"       "cos2 for the rows"           
9  "$row$contrib"    "contributions of the rows"   
10 "$call"           "summary called parameters"   
11 "$call$marge.col" "weights of the columns"      
12 "$call$marge.row" "weights of the rows"         

print(ca.model)

**Results of the Correspondence Analysis (CA)**
The row variable has  23  categories; the column variable has 19 categories
The chi square of independence between the two variables is equal to 4569.931 (p-value =  0 ).
*The results are available in the following objects:

   name              description                   
1  "$eig"            "eigenvalues"                 
2  "$col"            "results for the columns"     
3  "$col$coord"      "coord. for the columns"      
4  "$col$cos2"       "cos2 for the columns"        
5  "$col$contrib"    "contributions of the columns"
6  "$row"            "results for the rows"        
7  "$row$coord"      "coord. for the rows"         
8  "$row$cos2"       "cos2 for the rows"           
9  "$row$contrib"    "contributions of the rows"   
10 "$call"           "summary called parameters"   
11 "$call$marge.col" "weights of the columns"      
12 "$call$marge.row" "weights of the rows"         

Screeplot

Визуализируйте screeplot.

Запишите ваши выводы, какую долю объясненной дисперсии представляют первые два измерения?

factoextra::fviz_screeplot(ca.model, addlabels = TRUE, ylim = c(0, 50))

Первые два измерения представляют 47% объясненной дисперсии.

Biplot

Постройте базовый биплот.

Постройте плот для данных в столбцах. Цвет должен отражать сontribution каждого конкретного столбца.

Здесь вы можете построить более продвинутый биплот с использованием цвета, прозрачности, repel.

factoextra::fviz_ca_biplot(ca.model, col.col="contrib", col.row = "black", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE, alpha.col=1, alpha.row=0.3)

Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.

для лучшей читабельности, т.к. не получилось изменить прозрачность лэйблов:

factoextra::fviz_ca_col(ca.model, col.col="contrib", col.row = "black", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE, alpha.col=1, alpha.row=0.3)

Выводы

Предложите ваш анализ визуализаций, полученных методом Анализа соответствий.

- вспомогательные глаголы `мочи` и `хотѣти` чаще употребляются с инфинитивами `сотворити`, `учинити`, `итти`, `дати`, `послати`
- вспомогательные глаголы `почати`, `начати`, `учати` и `стати` чаще употребляются с инфинитивами `говорити`, `воевати`, `пѣти`, `глаголати`, `жити`, `просити`, `бити`, `посылати`, `дѣлати`, `творити`

Полезные ссылки:

• https://statsandr.com/blog/chi-square-test-of-independence-in-r/

• https://www.sthda.com/english/articles/31-principal-component-methods-in-r-practical-guide/113-ca-correspondence-analysis-in-r-essentials/